home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar - Compleat Programmer
/
comprog1.d81
/
b.modeling iii
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-28
|
6KB
|
211 lines
1 remsave"r.minnie.v4.1",8
2 goto 400
3 rem ========raspberry========
4 :
5 r=54272:poker+6,240:poker+1,4:poker+5,0:poker+4,33:poker+24,15
6 forz=1024to512step-8:poker+1,z/256:poker,zand255:next:poker+4,0:return
7 :
8 rem==========fanfare=========
9 :
10 t=87:n$="251331421502421502"
11 s=54272:pokes+6,96:pokes+24,15
12 fori=1to18step3
13 pokes+1,val(mid$(n$,i,2)):pokes+4,33
14 forj=1tot*val(mid$(n$,i+2,1)):next
15 pokes+4,0:next:return
16 :
17 rem ======creates screen save
18 :
20 for i=828to972:reada:x=x+a:pokei,a:next
22 data169,000,133,251,133,253,141
23 data055,003,141,057,003,141,059
24 data003,162,000,160,000,177,251
25 data145,253,200,192,000,208,247
26 data230,252,230,254,232,224,004
27 data208,238,173,056,003,133,252
28 data173,058,003,133,254,238,059
29 data003,174,059,003,224,002,208
30 data214,096,169,004,133,252,169
31 data192,133,254,169,216,141,056
32 data003,169,196,141,058,003,076
33 data060,003,169,192,133,252,169
34 data004,133,254,169,196,141,056
35 data003,169,216,141,058,003,076
36 data060,003,169,004,133,252,169
37 data200,133,254,169,216,141,056
38 data003,169,204,141,058,003,076
39 data060,003,169,200,133,252,169
40 data004,133,254,169,204,141,056
41 data003,169,216,141,058,003,076
42 data060,003,000,000,000
43 dimch$(11):fori=1to9:ch$(i)=str$(i):next:ch$(10)="h":ch$(11)="q":return
47 :
48 rem==========again?==============
49 :
50 x=15:y=10:w$=" again? [157][157][157][157][157][157][157][157] (y/n) ":gosub66:goto62
54 :
55 rem==========any key-get a$=========
56 :
58 x=13:y=24:w$=" any key [145]":gosub66
59 :
60 rem============get a$===========
61 :
62 geta$:ifa$=""then 62:return
63 :
64 rem=======print at=============
65 :
66 poke783,peek(783)and254:poke782,x:poke781,y:sys65520:printw$
68 poke783,peek(783)or1:return
106 :
107 rem===dim,define,once only stuff===
109 :
111 nc=52:dims(nc),d$(14),va$(13),b(9,13):z9=0
112 fori=0to3:reads$(i):readco$(i):next
113 fori=0to12:readva$(i):next
115 data"[216]","[144]","[218]","","[211]","","[193]","[144]",2,3,4,5,6,7,8,9,10,j,q,k,a
116 data2,5,10,5,18,5,26,5,2,14,10,14,18,14,26,14,34,7
117 for i=1 to 9:readx(i):ready(i):next
118 pu$=" pick up? ":dr$=" drop? "
119 c$="[158][176][192][192][192][192][174][157][157][157][157][157][157][221] [221][157][157][157][157][157][157][221] [221][157][157][157][157][157][157][221] [221]"
120 c$=c$+ "[157][157][157][157][157][157][221] [221][157][157][157][157][157][157][221] [221][157][157][157][157][157][157][173][192][192][192][192][189]"+"[145][145][145][145][145][157][157][157][157][157]"
121 b$=c$+"[158][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166]"
122 bl$=" [157][157][157][157][157][157] [157][157][157][157][157][157] [157][157][157][157][157][157] [157][157][157][157][157][157] [157][157][157][157][157][157]"
123 bl$=bl$+" [157][157][157][157][157][157] [157][157][157][157][157][157] "
125 rem========shuffle & deal======
126 :
127 forj=0tonc-1:s(j)=j:next
128 forj=0tonc-2:j%=j+(rnd(0)*(nc-j))
129 temp=s(j):s(j)=s(j%):s(j%)=temp:next:fori=1to9:c(i)=0:next
130 k=0:fori=5to8:forj=1to10:b(i,j)=s(k):k=k+1:c(i)=c(i)+1:next:next
131 for j=1to 12:b(9,j)=s(k):k=k+1:c(9)=c(9)+1:next:return
137 :
138 rem ======suits,values,graphics===
139 :
140 su=(int(b(i,c(i))/13)):t=13*int(b(i,c(i))/13)
142 de$=co$(su)+va$(b(i,c(i))-t)
144 df$=de$+s$(su):df$=c$+df$:x=x(i):y=y(i):w$=df$
146 if c(i)=0thenw$=bl$
147 ifi=9andpd=2thenw$=b$
148 goto 66
207 :
208 rem======get pick/drop======
209 :
210 geta$:if a$=""then210
212 for i=1to11:ifa$=right$(ch$(i),1)then 216
214 next
215 goto210
216 return
219 :
220 rem=====help screen=====
222 print"[147]":printtab(4)"[164][175][185] mindless minnie's mania [185][175][164]":print
223 print
224 print" the object of the game is to remove all 12 cards from pile 9."
226 print
228 print" cards may be played on any empty spaceor on stacks 1-8 if the ";
232 print"top card has thesame value. on 5-9 a card can also be played";
236 print" if the top card has a value one larger.";
237 print" cards may be played from one pile to";
238 print" another.":print
240 print" aces are high only and suits are not important.";
242 print" when the cards are dealt there are ten";
244 print" cards in piles 5-9. ";
245 print" no pile can contain more than 13 cards."
247 print
248 print" the program does not decide when you "
250 print"lose, so type q if you want to give up."
252 print"also type q to return to loadstar."
300 sys886:z9=1:return
397 :
398 rem========start of program=======
399 :
400 z9=0:poke53280,5:poke53281,5: printchr$(8);chr$(142):print"[147]"
401 r$=" ":printr$"[176][192][192][192][192][192][192][192][192][192][192][192][192][174]"
402 printr$"[221] [221]"
403 printr$"[221] mindless [221]"
404 printr$"[221] [221]"
405 printr$"[221] minnie's [221]"
406 printr$"[221] [221]"
407 printr$"[221] mania [221]"
408 printr$"[221] [221]"
409 printr$"[173][192][192][192][192][192][192][192][192][192][192][192][192][189]"
410 gosub20:rem==load screen switch====
420 print"[147]"
421 printr$"[176][192][192][192][192][192][192][192][192][192][192][192][192][174]"
422 printr$"[221] [221]"
423 printr$"[221] a game [221]"
424 printr$"[221] [221]"
425 printr$"[221] of [221]"
426 printr$"[221] [221]"
427 printr$"[221] solitaire [221]"
428 printr$"[221] [221]"
429 printr$"[173][192][192][192][192][192][192][192][192][192][192][192][192][189]"
430 gosub111: rem first deal
440 print"[147]"
441 printr$"[176][192][192][192][192][192][192][192][192][192][192][192][192][174]"
442 printr$"[221] [221]"
443 printr$"[221] by [221]"
444 printr$"[221] [221]"
445 printr$"[221] maurice [221]"
446 printr$"[221] [221]"
447 printr$"[221] jones [221]"
448 printr$"[221] [221]"
449 printr$"[173][192][192][192][192][192][192][192][192][192][192][192][192][189]"
450 :
455 gosub 127: rem== only for delay==
457 :
458 rem =====playing board=============
459 :
460 print"[147] mindless minnie's mania "
461 print" 1 2 3 4 9"
462 print" 5 6 7 8 "
464 x=34:y=7:w$=b$:gosub66:fori=5to8: gosub140:next
466 x=32:y=22:w$=" h-help [157][157][157][157][157][157][157][157] q-quit [145]":gosub66
467 :
468 rem========pickup card=============
469 :
470 x=12:y=23:w$=pu$:gosub66:gosub210
472 sg=0:pd=1:onigoto474,474,474,474,474,474,474,474,700,990,993
474 if c(i)=0then gosub 5:gosub210:goto472
476 m=b(i,c(i)):c(i)=c(i)-1:tm=i:gosub140
477 rem========drop card=============
478 x=12:y=23:w$=dr$:gosub66:gosub210
480 pd=2:onigoto482,482,482,482,482,482,482,482,482,990,993
482 ifc(i)=13ori=9 then660
500 np=0:t5=b(i,c(i))-13*int(b(i,c(i))/13):t6=m-13*int(m/13)
510 ift5=t6then600
520 ifi>4andt5=t6+1 then 600
530 ifc(i)=0then600
540 goto660
600 iftm=9then 630
610 c(i)=c(i)+1:b(i,c(i))=m:gosub140:ifc(9)=0then800
620 goto470
630 tm=i:i=9:gosub140:i=tm:goto610
660 gosub5:i=tm:c(i)=c(i)+1:gosub140:goto470
700 m=b(i,c(i)):gosub140:c(i)=c(i)-1:tm=i: sg=1:goto478
797 :
798 rem========win screen============
799 :
800 w$=bl$:x=34:y=7:gosub66:gosub10:w$=" you win!!! "
802 x=3:y=1:fori=1to22:gosub66:x=x+1:y=y+1:next:goto993
967 :
980 x=5:y=23:w$="are you sure? (y/n)":gosub66:gosub62
982 if a$="y"then60000
983 ifa$<>"n"then980
984 x=5:y=23:w$=" ":gosub66:onpdgoto470,478
987 :
988 rem========display help screen====
989 :
990 sys928:if z9=0thengosub222
991 :
992 sys907:gosub58:sys949:gosub210:onpdgoto472,480
993 gosub50:rem== play again?==========
995 ifa$="n"then60000
997 if a$="y"thenprint"[147] dealing . . . "
998 gosub128:goto460
999 gosub 62:goto995
60000 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
60010 if er<>63 then print"[147]":end
60020 a$="hello connect":q$=chr$(34)
60030 poke646,peek(53281):print"[1